home *** CD-ROM | disk | FTP | other *** search
/ Mac-Source 1994 July / Mac-Source_July_1994.iso / Other Langs / MacPerl ƒ / Perl Source ƒ / Perl / t / MacPerlTest next >
Text File  |  1993-10-23  |  2KB  |  114 lines
  1. ::Perl -Sx "{0}" prepare {"Parameters"} > MacPerlTest.Run
  2. :MacPerlTest.Run ∑ MacPerlTest.Out
  3. ::Perl -Sx "{0}" evaluate {"Parameters"} MacPerlTest.Out
  4. Delete MacPerlTest.Out MacPerlTest.Run
  5. Exit 0
  6.  
  7. #!./perl
  8.     
  9. # $RCSfile: TEST,v $$Revision: 4.0.1.1 $$Date: 91/06/07 11:59:30 $
  10.  
  11. # This is written in a peculiar style, since we're trying to avoid
  12. # most of the constructs we'll be testing for.
  13.  
  14. $| = 1;
  15.  
  16. $operation = shift;
  17.  
  18. if ($ARGV[0] eq '-v') {
  19.     $verbose = 1;
  20.     shift;
  21. }
  22.  
  23. die "Run me from the :t directory" if (-f ':t:TEST');
  24.  
  25. if ($operation eq "prepare") {
  26.     print "Set Exit 0\n";
  27.     
  28.     if ($ARGV[0] eq '') {
  29.          @ARGV = split(/[ \n]/,
  30.             `echo :base:≈.t :comp:≈.t :cmd:≈.t :io:≈.t; echo :op:≈.t :lib:≈.t`);
  31.     }
  32.     
  33.     $bad = 0;
  34.     while ($test = shift) {
  35.         if ($test =~ /^$/) {
  36.             next;
  37.         }
  38.         $te = $test;
  39.         chop($te);
  40.         print "echo \'----- $te" . '.' x (20 - length($te)) . "\'\n";
  41.         open(script,"$test") || die "Can't run $test.\n";
  42.         $_ = <script>;
  43.         close(script);
  44.         if (/#!..perl(.*)/) {
  45.             $switch = $1;
  46.         } else {
  47.             $switch = '';
  48.         }
  49.         print "::Perl$switch $test\n";
  50.     }
  51. } elsif ($operation eq "evaluate") {
  52.     $_ = "";
  53.     
  54. tests: while (1)    {
  55.         while (1) {
  56.             last if /^-----/;
  57.             last tests unless ($_ = <>);
  58.         } 
  59.  
  60.         $_ =~ /----- (.*)/;
  61.         
  62.         print $1;
  63.         $ok = 0;
  64.         $next = 0;
  65.         
  66.         while (<>) {
  67.             last if (/^-----/);
  68.             
  69.             if ($verbose) {
  70.                 print "\t$_";
  71.             }
  72.             unless (/^#/) {
  73.                 if (/^1\.\.([0-9]+)/) {
  74.                     $max = $1;
  75.                     $totmax += $max;
  76.                     $files += 1;
  77.                     $next = 1;
  78.                     $ok = 1;
  79.                  } else {
  80.                     $next = $1, $ok = 0, last if /^not ok ([0-9]*)/;
  81.                     if (/^ok (.*)/ && $1 == $next) {
  82.                         $next = $next + 1;
  83.                     } else {
  84.                         $ok = 0;
  85.                     }
  86.                 }
  87.             }
  88.         }
  89.         $next = $next - 1;
  90.         if ($ok && $next == $max) {
  91.             print "ok\n";
  92.         } else {
  93.             $next += 1;
  94.             print "FAILED on test $next\n";
  95.             $bad = $bad + 1;
  96.         }
  97.         
  98.         last unless /^-----/ || !$ok;
  99.     }
  100.     if ($bad == 0) {
  101.         if ($ok) {
  102.             print "All tests successful.\n";
  103.         } else {
  104.             die "FAILED--no tests were run for some reason.\n";
  105.         }
  106.     } else {
  107.         if ($bad == 1) {
  108.             print "Failed 1 test.\n";
  109.         } else {
  110.             print "Failed $bad tests.\n";
  111.         }
  112.     }
  113. }
  114.